Loadstar 33/033.d81/addition master

Commodore BASIC | 1987-01-01 | 8.6 KB | 318 lines

1 ln$="----------"
2 goto2000
5 c=ma:ifsx(c)thenu(tr(co(r,c)))=.
10 ifnthen35
15 f=.:c=c-1:ifc=.thenreturn
20 ifsx(c)thenu(tr(co(r,c)))=.
25 n=nd(c):ifn=.then15
30 fori=1ton:l(i)=tr(di(c,i)):next
35 gosub258:iffthen15
40 fori=1ton:tj=l(i):sj=so(di(c,i)):gosub270:ifa1=.then35
45 tr(di(c,i))=tj:next
50 tj=ca(c-1):fori=1tor-1:ifc>len(rw$(i))then65
52 ifpeek(198)<>0thengosub5000:ifag=1thenrun
55 ifrp(c)=ithen65
60 tj=tj+tr(co(i,c))
65 next:ca(c)=int(tj/10):tj=tj-10*ca(c):ifrp(c)theniftjthen10
70 ifrp(c)then105
75 a=co(r,c):ifathenifsx(c)then90
80 iftj=tr(a)then105
85 goto10
90 ifu(tj)then10
95 sj=so(a):gosub270:ifa1=.then10
100 tr(a)=tj:u(tj)=1
105 c=c+1:ifc>mathen120
110 a1=.:n=nd(c):ifn=.then50
115 gosub252:goto40
120 tj=ca(ma):iftj=.thenonlr-ma+1goto155,5
125 iflr=mathen5
130 a=co(r,lr):ifsx(c)=.then150
135 ifu(tj)then5
140 sj=so(a):gosub270:ifa1=.then5
145 tr(a)=tj:u(tj)=1:goto155
150 iftr(a)-tjthen5
155 n=nd(12):ifn=.then192
160 gosub252:goto185
165 ifn=.then175
170 gosub258:iff=.then185
175 ifsx(lr)thenu(tr(co(r,lr)))=.
180 c=ma:f=.:goto20
185 fori=1ton:tj=l(i):sj=so(di(12,i)):gosub270:ifa1=.then170
190 tr(di(12,i))=tj:next
192 fori=1tor:iftr(co(i,len(rw$(i))))=.then165
195 ifcl(i)=0then230
200 a=0:fora1=len(rw$(i))to1step-1:a=10*a+tr(co(i,a1)):next
202 ifcl(i)>2then215
205 gosub350:ifcl(i)+(a1>0)=1then230
210 goto165
215 ifcl(i)>4then230
220 b=int(sqr(a)*a2):a1=3:ifa=b*bthena1=4
225 ifcl(i)=a1then165
230 nexti:b$=ti$:s=s+1:ifs=1thengosub475:goto235:rem solution
232 print:print"the next solution is ready...":print"press a key to see it."
233 ifp<4thengosub465
235 print"[147]";:gosub400:ifpthencmdp:gosub400:print#p
240 print:print"let me get back to work ...":print"<press a key to quit>"
245 ti$=b$:goto165
250 :
251 rem subroutines
252 i=1
253 l(i)=-1
254 l(i)=l(i)+1:ifu(l(i))thenifl(i)<9then254
255 ifl(i)=9thenifu(9)then259
256 u(l(i))=1:ifi<ntheni=i+1:goto253
257 return
258 fori=nto1step-1:u(l(i))=.:ifl(i)<9then254
259 next:f=1:return
260 :
265 rem check clues
270 a1=0:onsj-9goto275,275,280,290,295,300,305
275 a1=sj+tj+1and1:return
280 iftj<3thena1=tj
285 return
290 a1=1:return
295 a1=abs(3-abs(tj-5))=1:return
300 a1=tj:return
305 a1=abs(2.5-abs(tj-5))-.5:return
340 :
345 rem prime test
350 ifa<4thena1=0:return
355 ifa/2=int(a/2)thena1=2:return
360 fora1=3tosqr(a)step2:ifa/a1=int(a/a1)thenreturn
365 next:a1=0:return
370 print"[147]";:rem display puzzle
375 fori=1tor
380 ifi=rthenprintspc(15-lr)left$(ln$,lr)
385 printspc(15-len(rw$(i)))rw$(i):next:print
390 fori=0tonc:printcs$(i):next:print:return
395 rem display solution
400 printspc(11)"solution no."s:printspc(9)"==================="
405 printspc(9)"time so far: "b$:print
410 fori=1tor:a1=len(rw$(i))
415 ifi=rthenprintspc(13-lr)left$(ln$,lr)spc(15-lr)left$(ln$,lr)
420 printspc(13-a1)rw$(i)spc(15-a1);
425 fora=a1to1step-1:printchr$(48+tr(co(i,a)));:next
430 print:next:print
435 fori=1tonm:print"  "in$(i);:next:print
440 print" ";:fori=1tonm:printtr(i);:next:print
445 print:fori=1tonc:printcs$(i):next
450 return
455 :
460 rem input and beep
465 gosub475:rem beep
470 wait198,3:geta$:poke198,0
475 poke54296,15:fori=1to20:next:poke54296,0:return
490 :
495 rem enter puzzle
500 gosub900:goto520
510 print:print"i can't handle this stuff..."
520 clr:dimi,c,n,tj,a,a1,sj,r:a2=1+2e-7
525 ifpeek(828)thenp=4:openp,p
530 diml(11),u(11),tr(10),di(12,10),rp(11),ca(12),co(11,11),so(10),rw$(11)
535 dimsx(20),nd(12),sl(20,10),cl(11),cs$(30),sl$(20)
540 gosub475
542 print"[155]there must be between 3 and 11 lines,   including the sum."
545 input"how many lines (0 to quit) ";r:ifr=0thenrun
550 ifr<3orr>11then510
555 print:print"enter each line separately:":print
560 fori=1tor
565 inputrw$(i):iflen(rw$(i))>10then510
570 iflen(rw$(i))=0then510
575 next:print
580 cs$(0)="                "
585 lr=len(rw$(r)):gosub370
590 fori=1tor:b=len(rw$(i)):ifi=rthen610
600 ifb=mathena1=a1+1
605 ifb>mathena1=0:ma=b
610 forn=1tob:a$=left$(right$(rw$(i),n),1)
615 ifasc(a$)<65thena=0:in$(0)=a$:l(0)=1:goto635
620 fora=1to10:ifin$(a)=a$then635
625 ifin$(a)=""thenin$(a)=a$:nm=a:goto635
630 next:nm=11
635 co(i,n)=a
640 nextn,i
645 ifma>lrorlr>ma+1then510
650 print"i found"nm"letters:":ifnm<2ornm>10then510
655 fori=1tonm:print" "in$(i);:so(i)=13:tr(i)=10:next:print
660 iflr=mathen675
665 ifa1=1thenso(a)=12
670 ifa1=0thentr(a)=1:so(a)=1:u(1)=1:l(a)=1:nc=1:cs$(1)=in$(a)+" must be 1"
675 gosub1000:rem clues
680 fori=1tor:a=co(i,len(rw$(i))):ifso(a)=13thenso(a)=15
685 ifso(a)=0thenprintcs$(0):printin$(a)" can't be zero!":goto510
690 next
695 gosub370
700 print"this will take a few minutes--"
702 print"should i <p>roceed or <c>ancel?"
705 poke198,0:wait198,1:geta$:ifa$<>"p"anda$<>"c"then705
715 ifa$="c"then520
720 :
725 ti$="000000":print"thinking...":print"<press a key to quit>"
730 forc=1toma:i=0:forn=1tor-1:ifc>len(rw$(n))then750
735 a=co(n,c):ifl(a)ora=0then750
740 ifrp(c)=0thenifa=co(r,c)thenrp(c)=n:goto750
745 i=i+1:di(c,i)=a:l(a)=1
750 next:nd(c)=i:ifl(co(r,c))orrp(c)then760
755 l(co(r,c))=1:sx(c)=1
760 next:iflr>mathenifl(co(r,lr))=0thenl(co(r,lr))=1:sx(lr)=1
765 i=0:forc=1toma:a=co(r,c):ifl(a)then775
770 i=i+1:di(12,i)=a:l(a)=1
775 next:nd(12)=i:c=1
800 gosub110:rem solution
810 b$=ti$:gosub475:print" total time: "b$
815 ifpthencmdp:print" total time: "b$:print#p
820 ifsthenprint"no more solutions":goto520
825 ifpthencmdp:gosub375:print" sorry.. no solution found":print#p
830 gosub375:print"sorry.. no solution found":goto520
890 :
895 rem instructions
900 print"[147]","addition puzzle":print,"+++++++++++++++":print
905 print"this program solves alphametic addition puzzles of this type:"
910 print:print"   was":print"  that":print"   all"
912 print" -----":print" right"
915 print:print"each letter stands for a different digit"
920 print"simply enter the puzzle when prompted."
925 print"allow several minutes for the solution."
930 print:print"any clues you can offer will speed the"
935 print"process.  in this example, r must be 1;"
940 print"it is given that 'was' must be square."
950 print"using a printer? y/n"
955 gosub465:print"[147]"
960 ifa$<>"y"thenpoke828,0:return
965 print:print"enter the date (no commas)":inputa$
967 open15,4,15:close15:ifst<>0then60000
970 poke828,4:open4,4
975 print#4,chr$(14)"**addition master** "a$
980 return
990 :
995 rem get clues
1000 print:print"can you offer any clues? y/n"
1010 cs$(21)="prime":cs$(22)="not prime":cs$(23)="square"
1020 cs$(24)="not square":cs$(26)="even":cs$(27)="odd":cs$(28)="1 or 2"
1030 gosub465:ifa$="n"thenreturn
1040 gosub370:print:print"press the letter the clue is for."
1050 print"to specify a line, press the space bar:"
1060 gosub470:ifa$=" "then1350
1070 fori=1tonm:ifin$(i)=a$then1100
1080 next
1090 printa$"???":goto1330
1100 print:print"press the value of the letter '"a$"', or..."
1110 print"a  if even":print"b  if odd":print"c  if it could be 1 or 2"
1120 wait198,3:getb$:tj=asc(b$)-48+7*(b$>"9")
1130 iftj<0ortj>12then1090
1140 sj=so(i):iftj<10then1230
1150 ifsj<10thenprinta$" is"sj:goto1330
1160 onsj-9goto1170,1180,1190,1310,1200,1310,1210
1170 ontj-9goto1090,510,1580
1180 ontj-9goto510,1090,1570
1190 ontj-9goto1590,1570,1090
1200 ontj-9goto510,1310,1570
1210 ontj-9goto1310,1310,1570
1230 ifsj=tjthen1090
1240 ifsj<10then510
1250 gosub270:ifa1=0then510
1260 nc=nc+1:cs$(nc)=in$(i)+" must be"+str$(tj)
1270 u(tj)=1:l(i)=1:tr(i)=tj:so(i)=tj
1280 forn=1tonm:ifi=nthen1300
1290 iftj=so(n)thenprint:printin$(i)" & "in$(n)" can't both be"tj:goto510
1300 next:goto1320
1310 so(i)=tj:nc=nc+1:cs$(nc)=in$(i)+" must be "+cs$(tj+16)
1320 print:printcs$(nc)
1330 print"any more clues? y/n":goto1030
1340 :
1350 print:input"line number";a:ifa<1ora>rthen1090
1360 print:printrw$(a)" - is it:"
1370 print:print"1 prime?":print"2 not prime?"
1380 print"3 square?":print"4 not square?"
1390 print"5 odd?":print"6 even?"
1400 print"press a number."
1410 gosub465:b=val(a$):ifb=0orb>6then1090
1420 i=co(a,1):nc=nc+1:ifb<5then1440
1430 cs$(nc)=rw$(a)+" is "+cs$(32-b):tj=16-b:a$=in$(i):goto1140
1440 cl(a)=b:cs$(nc)=rw$(a)+" is "+cs$(b+20)
1450 iflen(rw$(a))<=8then1460
1455 cl(a)=0:print"i can't ensure that":cs$(nc)=cs$(nc)+"??"
1460 iflen(rw$(a))=1then1320
1470 onbgoto1490,1320,1530,1320
1480 :
1490 so=so(i)+1
1495 onsogoto505,1320,510,1320,510,510,510,1320,510,1320,510,1510,1570
1500 ifso(i)=16then510
1510 so(i)=14:goto1320
1520 :
1530 onso(i)+1goto1320,1320,510,510,1320,1320,1320,510,510,1320,1320
1540 onso(i)-10goto1320,1570,1550,510
1550 so(i)=16:goto1320
1560 :
1570 a=1:goto1590
1580 a=2
1590 so(i)=a:tr(i)=a:u(a)=1:l(i)=1:nc=nc+1
1600 cs$(nc)=in$(i)+" must be"+str$(a):goto1280
1990 :
1995 rem title screen
2000 poke54273,50:poke54278,243:poke54276,33
2010 poke53269,0:poke53281,0:printchr$(142)
2020 print"[147][150]      * * * addition  master * * *     [154]"
2030 printtab(14)"[150]by ian adam"
2040 printtab(13)"[154]would you like:"
2050 printtab(13)"[159]1[154]. addition puzzle"
2060 printtab(13)"[159]2[154]. prime numbers"
2070 printtab(13)"[159]3[154]. squares"
2080 printtab(13)"[159]0[154]. end"
2090 gosub465
2095 ifa$<"0"ora$>"3"then2090
2100 onval(a$)+1goto6000,500,2500,3000
2490 :
2500 print"[147]prime numbers"
2510 print:print"1. test a number":print"2. list primes"
2520 print"3. list non-primes":print"4. back to menu"
2530 gosub470:b=val(a$):ifb<1orb>3thenrun
2560 print"[147]enter 0 to stop"
2570 print:print"what number to start?"
2580 c=0:inputc:gosub475:c=int(c):ifc<1then2500
2590 ifabs(c)>4e5thenprint"...thinking"
2600 ifabs(c)>4e9thenprint"that's too big!":print:goto2510
2610 ifb>1then2670
2620 a=abs(c):gosub350
2630 ifa1=0thenprintc"is prime":goto2660
2640 printc"is not prime, being"
2650 print"divisible by"a1"and"c/a1
2660 print:print"next";:goto2580
2670 ford=1to22:a=abs(c):gosub350:c=c+1
2680 if(a1>0)=b-3thend=d-1:next
2690 printc-1:next:print"more?"
2700 gosub465:ifa$="n"then2500
2710 goto2590
2990 :
3000 print"[147]square numbers"
3010 print:print"1. test a number":print"2. list squares"
3020 print"3. back to menu":k3=1+2e-7:gosub470:d=val(a$)
3030 ifd=0ord>2thenrun
3040 print:print"what number to start?"
3050 print"enter 0 to quit"
3060 a=0:inputa:gosub475:a=abs(int(a)):ifa=0then3000
3070 ifa>4e9then3180
3080 ifd=2thenb=int(sqr(a-1))+1:goto3140
3090 b=sqr(a):c=int(b*k3)
3100 print:printa"is ";
3110 ifa=c*cthenb=c:print"the square of"b:goto3130
3120 print"not square":print"root:"b
3130 print"next: ";:goto3050
3140 print"[147] square"tab(20)"root"
3150 forb=btob+21:print(b*b)tab(20)b:next
3160 print"more?";:gosub465:ifa$="n"then3000
3170 ifb*b<4e9then3140
3180 print:print"too big!":goto3010
5000 rem  quit processing
5010 print"  *** do you want to quit? ***"
5020 poke198,0:wait198,1:geta$:ifa$<>"y"anda$<>"n"then5020
5030 ag=0:ifa$="y"thenag=1:goto5040
5035 print"i shall continue with my work..."
5040 return
6000 open15,8,15,"r0:hello connect=hello connect":input#15,er:close15
6010 print"[147]";:ifer<>63thenend
6020 load"hello connect",8
60000 rem no printer
60010 print"[147]"spc(10)"printer not on-line..."
60020 fordl=1to3000:next:goto2000